
import Debug.QuickCheck

-------------------------------------------------------------------------

-- datatype for suit of a card
data Suit = Spades | Hearts | Diamonds | Clubs
  deriving (Eq, Show)

-- datatype for colour of a card
data Colour = Black | Red
  deriving (Eq, Show)

colour :: Suit -> Colour
colour Spades   = Black
colour Hearts   = Red
colour Diamonds = Red
colour Clubs    = Black

-------------------------------------------------------------------------

-- datatype for rank of a card
data Rank = Numeric Integer | Jack | Queen | King | Ace
  deriving (Eq, Show)

-- rankBeats rank1 rank2 checks if rank1 beats rank2
rankBeats :: Rank -> Rank -> Bool
rankBeats _           Ace         = False
rankBeats Ace         _           = True
rankBeats _           King        = False
rankBeats King        _           = True
rankBeats _           Queen       = False
rankBeats Queen       _           = True
rankBeats _           Jack        = False
rankBeats Jack        _           = True
rankBeats (Numeric m) (Numeric n) = m > n

prop_RankBeats a b =
  a /= b ==>
    rankBeats a b || rankBeats b a

-------------------------------------------------------------------------

-- datatype for card: a rank and a suit
data Card = Card{ rank :: Rank, suit :: Suit }
  deriving (Eq, Show)

-- cardBeats trump card1 card2 checks if card1 beats card2, given the trump suit
cardBeats :: Suit -> Card -> Card -> Bool
cardBeats trump c c' 
  | suit c == suit c' = rankBeats (rank c) (rank c')
  | suit c == trump   = True
  | otherwise         = False

-------------------------------------------------------------------------

-- datatype for a hand of cards
data Hand = Empty | Add Card Hand
  deriving (Eq, Show)

-- handBeats trump hand card checks if hand beats card, given the trump suit
handBeats :: Suit -> Hand -> Card -> Bool
handBeats trump Empty     c' = False
handBeats trump (Add c h) c' = cardBeats trump c c' || handBeats trump h c'

-- chooseCard trump beat hand chooses a card from hand to
-- play, when trump is the trump suit and beat is the card to 
-- be beaten
chooseCard :: Suit -> Card -> Hand -> Card
chooseCard trump beat (Add c Empty) = c
chooseCard trump beat (Add c rest) 
  | suit c == suit beat && suit c' /= suit beat              = c
  | suit c /= suit beat && suit c' == suit beat              = c'
  | cardBeats trump c  beat && not (cardBeats trump c' beat) = c
  | cardBeats trump c' beat && not (cardBeats trump c beat)  = c'
  | rankBeats (rank c) (rank c')                             = c'
  | otherwise                                                = c
 where
  c' = chooseCard trump beat rest

prop_chooseCardWinsIfPossible trump c h = 
  h /= Empty ==> 
    handBeats trump h c
      == cardBeats trump (chooseCard trump c h) c

-------------------------------------------------------------------------

instance Arbitrary Suit where
  arbitrary = elements [Spades, Hearts, Diamonds, Clubs]

instance Arbitrary Rank where
  arbitrary =
    oneof $
      [ do return c
      | c <- [Jack,Queen,King,Ace]
      ] ++
      [ do n <- choose (2,10)
           return (Numeric n)
      ]

instance Arbitrary Card where
  arbitrary =
    do r <- arbitrary
       s <- arbitrary
       return (Card r s)

instance Arbitrary Hand where
  arbitrary =
    do cs <- arbitrary
       let hand []     = Empty
           hand (c:cs) = Add c (hand cs)
       return (hand cs)

-------------------------------------------------------------------------

